home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / pkey12_1.zip / OH.LSP < prev    next >
Text File  |  1992-09-13  |  1KB  |  29 lines
  1. ;Overhead cabinets (very simplistic)
  2. ;
  3. ;
  4. (defun ohdtr (angg)
  5. (* pi (/ angg 180.0)))
  6. (if (= do1 nil)(setq *do1 24))
  7. (setq oer *error*  *error* err)
  8. (initget (+ 2 4))
  9. (setq do1(getdist(strcat "Enter countertop depth <" (rtos *do1) ">: ")))
  10. (if (= do1 nil)(setq do1 *do1)(setq *do1 do1))
  11. (setq *sk "xsink")
  12. (setq sk(getstring "\nDo you want a sink in this run ? <N>"))
  13. (if (= sk "")(setq *sk "")(setq *sk "d:\\kesym1\\xdsink"))
  14. (setq cd1(/ do1 2))
  15. (setq cd2 do1)
  16. (setq pt1 (getpoint "\nPick starting point :  "))
  17. (setq pt2 (getpoint pt1 "\nNext point  "))
  18. (if (= pt2 nil)(err))
  19. (setq ang (angle pt1 pt2))
  20. (setq pta (polar pt1 (+ ang (ohdtr 90)) cd2))
  21. (setq ptb (polar pt2 (+ ang (ohdtr 90)) cd2))
  22. (command "layer" "m" "MW" "")
  23. (command "line" pt1 pta ptb pt2 "")
  24. (setq pt5 (polar pt1 (+ ang (ohdtr 90)) cd1))
  25. (setq pt6 (polar pt2 (+ ang (ohdtr 90)) cd1))
  26. (command "layer" "m" "OH" "")
  27. (command "line" pt5 pt6 "")
  28. (if (= sk "")(setq sk nil)(command"LAYER""s""pf""""insert" *sk pause "" "" ))
  29. (princ)